home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 44 / Amiga Format CD44 (1999-08-26)(Future Publishing)(GB)(Track 1 of 3)[!][issue 1999-10].iso / -in_the_mag- / basics / amos / gridloc.lha / gridloc.asc next >
Text File  |  1994-09-05  |  5KB  |  141 lines
  1. ' Grid Square <-> latitude/longitude conversion  
  2. ' originally in QBASIC, from an unknown source 
  3. ' This Amiga version by Robert Davis K0FPC 3 September 1994
  4. Screen Open 7,640,200,4,Hires
  5. Palette $111,$333,$BBB,$555
  6. Curs Off 
  7. STRT:
  8.    Gosub RSTCLMNROW
  9.    Cls : Locate CLMN,ROW : Gosub ICRW
  10.    Print "Grid Square Locator"
  11.    Locate CLMN,ROW : Gosub ICRW
  12.    Print "Convert FROM?" : Locate CLMN,ROW : Gosub ICRW
  13.    Inverse On 
  14.    Print "L"; : Inverse Off : Print "at/Lon   ";
  15.    Inverse On 
  16.    Print "G"; : Inverse Off : Print "rid        ";
  17.    Inverse On 
  18.    Print "Q"; : Inverse Off : Print "uit   ";
  19.    Inverse On 
  20.    Print "A"; : Inverse Off : Print "bout Grid Locator"
  21. RPT1:
  22.     Do 
  23.     A$=Inkey$
  24.     If Upper$(A$)="Q" Then End 
  25.     If Upper$(A$)="L" Then Goto LL
  26.     If Upper$(A$)="G" Then Goto GRID
  27.     If Upper$(A$)="A" Then Goto ABOUTIT
  28.     Loop 
  29. LL:
  30. Rem clear the variable list
  31.     E9#=1E-06 : Cls : Gosub RSTCLMNROW
  32.     Locate CLMN,ROW : Gosub ICRW : 
  33.     Print "latitude / longitude"
  34.     Locate CLMN,ROW : Gosub ICRW
  35.     Print "Enter SOUTH latitude and EAST longitude as NEGATIVE numbers."
  36.     Locate CLMN,ROW : Gosub ICRW
  37.     Input "latitude (DD.MM) ";L# : Locate CLMN,ROW : Gosub ICRW
  38.     If L#<-90.0 or L#>90.0 Then Gosub RNGERR : Goto STRT
  39.     Input "longitude (DDD.MM) ";O#
  40.     If O#<-180.0 or O#>180.0 Then Gosub RNGERR : Goto STRT
  41.     OS=Sgn(O#) : O#=Abs(O#) : LS=Sgn(L#) : L#=Abs(L#)
  42.     LA#=(Int(L#)+(L#-Int(L#))/0.6)*LS
  43.     LO#=(Int(O#)+(O#-Int(O#))/0.6)*OS
  44.     If LO#<0 Then LO#=LO#+360.0
  45.     W3#=180.0-LO# : If W3#<0.0 Then W3#=W3#+360.0
  46.     W1#=Int(W3#/20.0+E9#)
  47.     W2#=Int((W3#-20.0*W1#)/2.0+E9#)+48.0 : W1#=W1#+65.0
  48.     W3#=Int(24.0*(W3#/2.0-Int(W3#/2.0))+E9#)+65.0
  49.     L1#=Int((LA#+90.0)/10.0+E9#) : L2#=Int(LA#+90.0+E9#-10.0*L1#)
  50.     L3#=Int((LA#+90.0-10.0*L1#-L2#)*24.0+E9#)
  51.     L1#=L1#+65.0 : L2#=L2#+48.0 : L3#=L3#+65.0
  52.     G$=Chr$(W1#)+Chr$(L1#)+Chr$(W2#)+Chr$(L2#)+Chr$(W3#)+Chr$(L3#)
  53.     Locate CLMN,ROW : Gosub ICRW
  54.     Print "Grid square = ";Upper$(G$) : Curs Off : Gosub ICRW
  55.     Locate CLMN+10,ROW : Inverse On : Print " Press a key to continue " : Inverse Off 
  56.     Wait Key : Goto STRT
  57. GRID:
  58. Rem clear the variables here 
  59.     E9#=1E-06 : Cls : Gosub RSTCLMNROW
  60.     Locate CLMN,ROW : Gosub ICRW : Print "GRID SQUARE" : Locate CLMN,ROW : Gosub ICRW
  61.     Print "Enter 2-, 4-, or 6-character grid square." : Locate CLMN,ROW : Gosub ICRW
  62.     Print "Short entries are optimized to center of square." : Locate CLMN,ROW : Gosub ICRW
  63.     Input "Grid square ";G$ : Curs Off 
  64.     G$=Upper$(G$)
  65.     L3=Len(G$) : If L3<2 or L3>6 Then Goto STRT
  66.     If L3=1 or L3=3 or L3=5 Then Goto STRT
  67.     If L3=2
  68.        G$=G$+"55LL"
  69.     End If 
  70.     If L3=4
  71.        G$=G$+"LL"
  72.     End If 
  73.     Locate CLMN,ROW : Gosub ICRW : Print "Grid square = ";G$;"      "
  74.     Restore : I=0
  75.     For X=1 To 6
  76.        Read Y$ : Read Z$
  77.        T$=Mid$(G$,X,1)
  78.        If(T$)<(Y$)
  79.          I=1
  80.        Else If(T$)>(Z$)
  81.          I=1
  82.        End If 
  83.        End If 
  84.     Next X
  85.     If I=1 Then Gosub RNGERR : Goto STRT
  86.     Data "A","R","A","S","0","9","0","9","A","X","A","X"
  87.     W1#=Asc(Left$(G$,1))-65.0
  88.     W2#=Asc(Mid$(G$,3,1))-48.0
  89.     W3#=Asc(Mid$(G$,5,1))-65.0
  90.     LO#=180.0-20.0*W1#-2.0*W2#-W3#/12.0-1.0/24.0
  91.     If LO#<0.0 Then LO#=LO#+360.0
  92.     L1#=Asc(Mid$(G$,2,1))-65.0
  93.     L2#=Asc(Mid$(G$,4,1))-48.0
  94.     L3#=Asc(Right$(G$,1))-65.0
  95.     LA#=-90.0+10.0*L1#+L2#+L3#/24.0+1.0/48.0
  96.     If LO#>180.0 Then LO#=LO#-360.0
  97.     LS=Sgn(LA#) : LA#=Abs(LA#)
  98.     L#=(Int(LA#)+Int((LA#-Int(LA#))*60.0)/100.0)*LS
  99.     OS=Sgn(LO#) : LO#=Abs(LO#)
  100.     O#=(Int(LO#)+Int((LO#-Int(LO#))*60.0)/100.0)*OS
  101.     Locate CLMN,ROW : Gosub ICRW
  102.     Print "latitude (DD.MM) =";L#
  103.     Locate CLMN,ROW : Gosub ICRW
  104.     Print "longitude (DDD.MM) =";O#
  105.     Locate CLMN,ROW : Gosub ICRW
  106.     Print "(SOUTH latitude and EAST longitude shown as negative numbers.)"
  107.     Locate CLMN+10,ROW : Inverse On : Print " Press a key to continue " : Inverse Off 
  108.     Wait Key : Goto STRT
  109. ABOUTIT:
  110.     Cls : Menu Off 
  111.     Gosub RSTCLMNROW : Locate CLMN,ROW : Gosub ICRW
  112.     Print " Grid Locator Amiga version in AMOS Basic by Robert Davis, K0FPC"
  113.     Locate CLMN,ROW : Gosub ICRW
  114.     Print " Calculate grid square anywhere from known latitude and longitude"
  115.     Locate CLMN,ROW : Gosub ICRW
  116.     Print " Calculate latitude and longitude anywhere from known grid square"
  117.     Locate CLMN,ROW : Gosub ICRW
  118.     Print " Enter latitude in range 0 - 90 degrees, 0 - 59 minutes."
  119.     Locate CLMN,ROW : Gosub ICRW
  120.     Print " Enter longitude in range 0 - 180 degrees, 0 - 59 minutes."
  121.     Locate CLMN,ROW : Gosub ICRW
  122.     Print " Separate degrees and minutes by a  .  (a period)."
  123.     Locate CLMN+10,ROW : Gosub ICRW
  124.     Inverse On : Print " Press a key to continue " : Inverse Off 
  125.     Clear Key 
  126.     Wait Key 
  127.     Goto STRT
  128. Rem the increment the row subroutine 
  129. ICRW:
  130.     Inc ROW : Inc ROW
  131.     Return 
  132. RNGERR:
  133.     Curs Off 
  134.     Print : Print "   Entry out of allowable range."
  135.     Print "   Press a key to restart program."
  136.     Wait Key 
  137.     Return 
  138. RSTCLMNROW:
  139.     CLMN=3 : ROW=3
  140.     Return 
  141.